home *** CD-ROM | disk | FTP | other *** search
/ Clickx 115 / Clickx 115.iso / software / tools / windows / tails-i386-0.16.iso / live / filesystem.squashfs / usr / sbin / import-ferm < prev    next >
Encoding:
Text File  |  2010-01-02  |  16.8 KB  |  625 lines
  1. #!/usr/bin/perl
  2.  
  3. #
  4. # ferm, a firewall setup program that makes firewall rules easy!
  5. #
  6. # Copyright (C) 2001-2010 Max Kellermann, Auke Kok
  7. #
  8. # Comments, questions, greetings and additions to this program
  9. # may be sent to <ferm@foo-projects.org>
  10. #
  11.  
  12. # This tool allows you to import an existing firewall configuration
  13. # into ferm.
  14.  
  15. #
  16. # This program is free software; you can redistribute it and/or modify
  17. # it under the terms of the GNU General Public License as published by
  18. # the Free Software Foundation; either version 2 of the License, or
  19. # (at your option) any later version.
  20. #
  21. # This program is distributed in the hope that it will be useful,
  22. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  23. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  24. # GNU General Public License for more details.
  25. #
  26. # You should have received a copy of the GNU General Public License
  27. # along with this program; if not, write to the Free Software
  28. # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  29. #
  30.  
  31. # $Id$
  32.  
  33. use strict;
  34.  
  35. use Data::Dumper;
  36.  
  37. BEGIN {
  38.     # find the main "ferm" program
  39.     my $ferm;
  40.     if ($0 =~ /^(.*)\//) {
  41.         $ferm = "$1/ferm";
  42.     } else {
  43.         $ferm = 'ferm';
  44.     }
  45.  
  46.     # import its module tables
  47.     require $ferm;
  48.  
  49.     # delete conflicting symbols
  50.     delete $main::{$_} for qw(merge_keywords parse_option);
  51. }
  52.  
  53. use vars qw(%aliases);
  54. %aliases = (
  55.     i => 'interface',
  56.     o => 'outerface',
  57.     p => 'protocol',
  58.     d => 'daddr',
  59.     s => 'saddr',
  60.     m => 'match',
  61.     j => 'jump',
  62.     g => 'goto',
  63. );
  64.  
  65. use vars qw($indent $table $chain @rules $domain $next_domain);
  66.  
  67. sub ferm_escape($) {
  68.     local $_ = shift;
  69.     return $_ unless /[^-\w.:\/]/s;
  70.     return "\'$_\'";
  71. }
  72.  
  73. sub format_array {
  74.     my $a = shift;
  75.     return ferm_escape($a) unless ref $a;
  76.     return ferm_escape($a->[0]) if @$a == 1;
  77.     return '(' . join(' ', map { ferm_escape($_) } @$a) . ')';
  78. }
  79.  
  80. sub write_line {
  81.     # write a line of tokens, with indent handling
  82.  
  83.     # don't add space before semicolon
  84.     my $comma = $_[-1] eq ';' ? pop : '';
  85.     # begins with closing curly braces -> decrease indent
  86.     $indent -= 4 if $_[0] =~ /^}/;
  87.     # do print line
  88.     print ' ' x $indent;
  89.     print join(' ', @_);
  90.     print "$comma\n";
  91.     # ends with opening curly braces -> increase indent
  92.     $indent += 4 if $_[-1] =~ /{$/;
  93. }
  94.  
  95. sub module_match_count {
  96.     my ($module, $rules) = @_;
  97.     my $count = 0;
  98.     foreach (@$rules) {
  99.         last unless $_->{mod}{$module};
  100.         $count++;
  101.     }
  102.     return $count;
  103. }
  104.  
  105. sub prefix_matches {
  106.     my ($a, $b) = @_;
  107.     return @{$b->{match}} > 0 &&
  108.       (Dumper($a->{match}[0]) eq Dumper($b->{match}[0]));
  109. }
  110.  
  111. sub prefix_match_count {
  112.     my ($prefix, $rules) = @_;
  113.     my $count = 0;
  114.     foreach (@$rules) {
  115.         last unless prefix_matches($prefix, $_);
  116.         $count++;
  117.     }
  118.     return $count;
  119. }
  120.  
  121. sub is_merging_array_member {
  122.     my $value = shift;
  123.     return defined $value &&
  124.       ((!ref($value)) or
  125.        ref $value eq 'ARRAY');
  126. }
  127.  
  128. sub array_matches($$) {
  129.     my ($rule1, $rule2) = @_;
  130.     return if @{$rule1->{match}} == 0 or @{$rule2->{match}} == 0;
  131.     return unless is_merging_array_member($rule1->{match}[0][1]);
  132.     return unless is_merging_array_member($rule2->{match}[0][1]);
  133.     return unless @{$rule2->{match}} > 0;
  134.     return unless $rule1->{match}[0][0] eq $rule2->{match}[0][0];
  135.     my %r1 = %$rule1;
  136.     my %r2 = %$rule2;
  137.     $r1{match} = [ @{$r1{match}} ];
  138.     $r2{match} = [ @{$r2{match}} ];
  139.     shift @{$r1{match}};
  140.     shift @{$r2{match}};
  141.     return Dumper(\%r1) eq Dumper(\%r2);
  142. }
  143.  
  144. sub array_match_count($\@) {
  145.     my ($first, $rules) = @_;
  146.     return 0 unless @{$first->{match}} > 0;
  147.     my $count = 0;
  148.     foreach (@$rules) {
  149.         last unless array_matches($first, $_);
  150.         $count++;
  151.     }
  152.     return $count;
  153. }
  154.  
  155. sub optimize {
  156.     my @result;
  157.  
  158.     # try to find a common prefix and put rules in a block:
  159.     # saddr 1.2.3.4 proto tcp dport ssh ACCEPT;
  160.     # saddr 5.6.7.8 proto tcp dport ssh DROP;
  161.     # ->
  162.     # proto tcp dport ssh {
  163.     #     saddr 1.2.3.4 ACCEPT;
  164.     #     saddr 5.6.7.8 DROP;
  165.     # }
  166.     while (@_ > 0) {
  167.         my $rule = shift;
  168.         if (@{$rule->{match}} > 0) {
  169.             my $match_count = prefix_match_count($rule, \@_);
  170.  
  171.             if ($match_count > 0) {
  172.                 my $match = $rule->{match}[0];
  173.                 my @matching = ( $rule, splice(@_, 0, $match_count) );
  174.                 map { shift @{$_->{match}} } @matching;
  175.  
  176.                 my @block = optimize(@matching);
  177.  
  178.                 if (@block == 1) {
  179.                     $rule = $block[0];
  180.                     unshift @{$rule->{match}}, $match;
  181.                     push @result, $rule;
  182.                 } else {
  183.                     push @result, {
  184.                         match => [ $match ],
  185.                         block => \@block,
  186.                     };
  187.                 }
  188.             } else {
  189.                 push @result, $rule;
  190.             }
  191.         } else {
  192.             push @result, $rule;
  193.         }
  194.     }
  195.  
  196.     @_ = @result;
  197.     undef @result;
  198.  
  199.     # try to combine rules with arrays:
  200.     # saddr 1.2.3.4 proto tcp ACCEPT;
  201.     # saddr 5.6.7.8 proto tcp ACCEPT;
  202.     # ->
  203.     # saddr (1.2.3.4 5.6.7.8) proto tcp ACCEPT;
  204.     while (@_ > 0) {
  205.         my $rule = shift;
  206.         my $match_count = array_match_count($rule, @_);
  207.  
  208.         if ($match_count > 0) {
  209.             my $option = $rule->{match}[0][0];
  210.             my @matching = ( $rule, splice(@_, 0, $match_count) );
  211.             my @params = map {
  212.                 (ref $_ and ref $_ eq 'ARRAY') ? @$_ : $_
  213.             } map {
  214.                 $_->{match}[0][1]
  215.             } @matching;
  216.  
  217.             $rule->{match}[0][1] = \@params;
  218.         }
  219.  
  220.         push @result, $rule;
  221.     }
  222.  
  223.     return @result;
  224. }
  225.  
  226. sub flush_option {
  227.     my ($line, $key, $value) = @_;
  228.  
  229.     if (ref($value) and ref($value) eq 'pre_negated') {
  230.         push @$line, '!';
  231.         $value = $value->[0];
  232.     }
  233.  
  234.     push @$line, $key;
  235.  
  236.     if (ref($value) and ref($value) eq 'negated') {
  237.         push @$line, '!';
  238.         $value = $value->[0];
  239.     }
  240.  
  241.     if (ref($value) and ref($value) eq 'params') {
  242.         foreach (@$value) {
  243.             push @$line, format_array($_);
  244.         }
  245.     } elsif (defined $value) {
  246.         push @$line, format_array($value);
  247.     }
  248. }
  249.  
  250. sub flush {
  251.     # optimize and write a list of rules
  252.  
  253.     my @r = @_ ? @_ : @rules;
  254.     @r = optimize(@r);
  255.  
  256.     foreach my $rule (@r) {
  257.         my @line;
  258.         # assemble the line, match stuff first, then target parameters
  259.         if (exists $rule->{match}) {
  260.             foreach (@{$rule->{match}}) {
  261.                 flush_option(\@line, @$_);
  262.             }
  263.         }
  264.  
  265.         if (exists $rule->{jump}) {
  266.             if (is_netfilter_core_target($rule->{jump}) ||
  267.                 is_netfilter_module_target('ip', $rule->{jump})) {
  268.                 push @line, $rule->{jump};
  269.             } else {
  270.                 flush_option(\@line, 'jump', $rule->{jump});
  271.             }
  272.         } elsif (exists $rule->{goto}) {
  273.             flush_option(\@line, 'realgoto', $rule->{goto});
  274.         } elsif (not exists $rule->{block}) {
  275.             push @line, 'NOP';
  276.         }
  277.  
  278.         if (exists $rule->{target}) {
  279.             foreach (@{$rule->{target}}) {
  280.                 flush_option(\@line, @$_);
  281.             }
  282.         }
  283.  
  284.         if (exists $rule->{block}) {
  285.             # this rule begins a block created in &optimize
  286.             write_line(@line, '{');
  287.             flush(@{$rule->{block}});
  288.             write_line('}');
  289.         } else {
  290.             # just a simple rule
  291.             write_line(@line, ';');
  292.         }
  293.     }
  294.     undef @rules;
  295. }
  296.  
  297. sub flush_domain() {
  298.     flush;
  299.     write_line '}' if defined $chain;
  300.     write_line '}' if defined $table;
  301.     write_line '}' if defined $domain;
  302.  
  303.     undef $chain;
  304.     undef $table;
  305.     undef $domain;
  306. }
  307.  
  308. sub tokenize($) {
  309.     local $_ = shift;
  310.     my @result;
  311.     while (s/^\s*"([^"]+)"//s || s/^\s*(!)// || s/^\s*(\S+)//s) {
  312.         push @result, $1;
  313.     }
  314.     return @result;
  315. }
  316.  
  317. sub fetch_token($\@) {
  318.     my ($option, $tokens) = @_;
  319.     die "not enough arguments for option '$option' in line $."
  320.       unless @$tokens > 0;
  321.     shift @$tokens;
  322. }
  323.  
  324. sub fetch_negated(\@) {
  325.     my $tokens = shift;
  326.     @$tokens > 0 && $tokens->[0] eq '!' && shift @$tokens;
  327. }
  328.  
  329. sub merge_keywords(\%$) {
  330.     my ($rule, $keywords) = @_;
  331.     while (my ($name, $def) = each %$keywords) {
  332.         $rule->{keywords}{$name} = $def;
  333.     }
  334. }
  335.  
  336. sub parse_def_option($\%$\@) {
  337.     my ($option, $def, $negated, $tokens) = @_;
  338.  
  339.     my $params = $def->{params};
  340.     my $value;
  341.  
  342.     $negated = 1 if fetch_negated(@$tokens);
  343.  
  344.     unless (defined $params) {
  345.         undef $value;
  346.     } elsif (ref $params && ref $params eq 'CODE') {
  347.         # XXX we assume this is ipt_multiport
  348.         $value = [ split /,/, fetch_token($option, @$tokens) ];
  349.     } elsif ($params eq 'm') {
  350.         $value = bless [ fetch_token($option, @$tokens) ], 'multi';
  351.     } elsif ($params =~ /^[a-z]/) {
  352.         die if @$tokens < length($params);
  353.  
  354.         my @params;
  355.         foreach my $p (split(//, $params)) {
  356.             if ($p eq 's') {
  357.                 push @params, shift @$tokens;
  358.             } elsif ($p eq 'c') {
  359.                 push @params, [ split /,/, shift @$tokens ];
  360.             } else {
  361.                 die;
  362.             }
  363.         }
  364.  
  365.         $value = @params == 1
  366.           ? $params[0]
  367.             : bless \@params, 'params';
  368.     } elsif ($params == 1) {
  369.         $value = fetch_token($option, @$tokens);
  370.     } else {
  371.         $value = bless [ map {
  372.             fetch_token($option, @$tokens)
  373.         } (1..$params) ], 'multi';
  374.     }
  375.  
  376.     $value = bless [ $value ], exists $def->{pre_negation} ? 'pre_negated' : 'negated'
  377.       if $negated;
  378.  
  379.     return $value;
  380. }
  381.  
  382. sub parse_option(\%$$\@) {
  383.     my ($line, $option, $pre_negated, $tokens) = @_;
  384.  
  385.     my $cur = $line->{cur};
  386.     die unless defined $cur;
  387.  
  388.     $option = $aliases{$option} if exists $aliases{$option};
  389.     $option = 'destination-ports' if $option eq 'dports';
  390.     $option = 'source-ports' if $option eq 'sports';
  391.  
  392.     if ($option eq 'protocol') {
  393.         my %def = ( params => 1 );
  394.         my $value = parse_def_option($option, %def, $pre_negated, @$tokens);
  395.         $line->{proto} = $value;
  396.         push @$cur, [ 'protocol', $value ];
  397.  
  398.         my $module = netfilter_canonical_protocol($value);
  399.         if (exists $proto_defs{ip}{$module}) {
  400.             merge_keywords(%$line, $proto_defs{ip}{$module}{keywords});
  401.         }
  402.  
  403.         if ($value =~ /^(?:tcp|udp|udplite|dccp|sctp)$/) {
  404.             my %def = (
  405.                 params => 1,
  406.                 negation => 1,
  407.                );
  408.             $line->{keywords}{sport} = { name => 'sport', %def };
  409.             $line->{keywords}{dport} = { name => 'dport', %def };
  410.         }
  411.         undef $pre_negated;
  412.     } elsif ($option eq 'match') {
  413.         die unless @$tokens;
  414.         my $param = shift @$tokens;
  415.         $line->{mod}{$param} = 1;
  416.         # we don't need this module if the protocol with the
  417.         # same name is already specified
  418.         push @$cur, [ 'mod', $param ]
  419.           unless exists $line->{proto} and
  420.             ($line->{proto} eq $param or
  421.              $line->{proto} =~ /^(ipv6-icmp|icmpv6)$/s and $param eq 'icmp6');
  422.  
  423.         my $module = $param eq 'icmp6' ? 'icmpv6' : $param;
  424.         if (exists $match_defs{ip}{$module}) {
  425.             merge_keywords(%$line, $match_defs{ip}{$module}{keywords});
  426.         } elsif (exists $proto_defs{ip}{$module}) {
  427.             merge_keywords(%$line, $proto_defs{ip}{$module}{keywords});
  428.         }
  429.  
  430.         if ($param =~ /^(?:tcp|udp|udplite|dccp|sctp)$/) {
  431.             my %def = (
  432.                 params => 1,
  433.                 negation => 1,
  434.                );
  435.             $line->{keywords}{sport} = { name => 'sport', %def };
  436.             $line->{keywords}{dport} = { name => 'dport', %def };
  437.         }
  438.     } elsif (exists $line->{keywords}{$option}) {
  439.         my $def = $line->{keywords}{$option};
  440.         my $value = parse_def_option($option, %$def, $pre_negated, @$tokens);
  441.  
  442.         if (ref $value and ref $value eq 'multi' and
  443.               @{$line->{cur}} > 0 and $line->{cur}[-1][0] eq $option and
  444.                 ref $line->{cur}[-1][1] eq 'multi') {
  445.             # merge multiple "--u32" into a ferm array
  446.             push @{$line->{cur}[-1][1]}, @$value;
  447.             return;
  448.         }
  449.  
  450.         undef $pre_negated;
  451.         push @{$line->{cur}}, [ $def->{ferm_name} || $def->{name}, $value ];
  452.     } elsif ($option eq 'jump') {
  453.         die unless @$tokens;
  454.         my $target = shift @$tokens;
  455.         # store the target in $line->{jump}
  456.         $line->{jump} = $target;
  457.         # what now follows is target parameters; set $cur
  458.         # correctly
  459.         $line->{cur} = $line->{target} = [];
  460.  
  461.         $line->{keywords} = {};
  462.         merge_keywords(%$line, $target_defs{ip}{$target}{keywords})
  463.           if exists $target_defs{ip}{$target};
  464.     } elsif ($option eq 'goto') {
  465.         die unless @$tokens;
  466.         my $target = shift @$tokens;
  467.         # store the target in $line->{jump}
  468.         $line->{goto} = $target;
  469.     } else {
  470.         die "option '$option' in line $. not understood\n";
  471.     }
  472.  
  473.     die "option '$option' in line $. cannot be negated\n"
  474.       if $pre_negated;
  475. }
  476.  
  477. if (grep { $_ eq '-h' || $_ eq '--help' } @ARGV) {
  478.     require Pod::Usage;
  479.     Pod::Usage::pod2usage(-exitstatus => 0,
  480.                           -verbose => 99);
  481. }
  482.  
  483. if (@ARGV == 0 && -t STDIN) {
  484.     open STDIN, "iptables-save|"
  485.       or die "Failed run to iptables-save: $!";
  486. } elsif (grep { /^-./ } @ARGV) {
  487.     require Pod::Usage;
  488.     Pod::Usage::pod2usage(-exitstatus => 1,
  489.                           -verbose => 99);
  490. }
  491.  
  492. print "# ferm rules generated by import-ferm\n";
  493. print "# http://ferm.foo-projects.org/\n";
  494.  
  495. $next_domain = $ENV{FERM_DOMAIN} || 'ip';
  496.  
  497. my %policies;
  498.  
  499. while (<>) {
  500.     if (/^(?:#.*)?$/) {
  501.         # empty or comment
  502.  
  503.         $next_domain = $1 if /^#.*\b(ip|ip6)tables(?:-save)\b/;
  504.     } elsif (/^\*(\w+)$/) {
  505.         # table
  506.  
  507.         if (keys %policies > 0) {
  508.             while (my ($chain, $policy) = each %policies) {
  509.                 write_line('chain', $chain, 'policy', $policy, ';');
  510.             }
  511.             undef %policies;
  512.         }
  513.  
  514.         unless (defined $domain and $domain eq $next_domain) {
  515.             flush_domain;
  516.             $domain = $next_domain;
  517.             write_line 'domain', $domain, '{';
  518.         }
  519.  
  520.         write_line('}') if defined $table;
  521.         $table = $1;
  522.         write_line('table', $table, '{');
  523.     } elsif (/^:(\S+)\s+-\s+/) {
  524.         # custom chain
  525.         die unless defined $table;
  526.         write_line("chain $1;");
  527.     } elsif (/^:(\S+)\s+(\w+)\s+/) {
  528.         # built-in chain
  529.         die unless defined $table;
  530.         $policies{$1} = $2;
  531.     } elsif (s/^-A (\S+)\s+//) {
  532.         # a rule
  533.         unless (defined $chain) {
  534.             flush;
  535.             $chain = $1;
  536.             write_line('chain', $chain, '{');
  537.         } elsif ($1 ne $chain) {
  538.             flush;
  539.             write_line('}');
  540.             $chain = $1;
  541.             write_line('chain', $chain, '{');
  542.         }
  543.  
  544.         if (exists $policies{$chain}) {
  545.             write_line('policy', $policies{$chain}, ';');
  546.             delete $policies{$chain};
  547.         }
  548.  
  549.         my @tokens = tokenize($_);
  550.  
  551.         my %line;
  552.         $line{keywords} = {};
  553.         merge_keywords(%line, $match_defs{ip}{''}{keywords});
  554.  
  555.         # separate 'match' parameters from 'target' parameters; $cur
  556.         # points to the current position
  557.         $line{cur} = $line{match} = [];
  558.         while (@tokens) {
  559.             local $_ = shift @tokens;
  560.             if (/^-(\w)$/ || /^--(\S+)$/) {
  561.                 parse_option(%line, $1, undef, @tokens);
  562.             } elsif ($_ eq '!') {
  563.                 die unless @tokens;
  564.                 $_ = shift @tokens;
  565.                 /^-(\w)$/ || /^--(\S+)$/
  566.                   or die "option expected in line $.\n";
  567.                 parse_option(%line, $1, 1, @tokens);
  568.             } else {
  569.                 print STDERR "warning: unknown token '$_' in line $.\n";
  570.             }
  571.         }
  572.         delete $line{cur};
  573.         push @rules, \%line;
  574.     } elsif ($_ =~ /^COMMIT/) {
  575.         flush;
  576.  
  577.         if (defined $chain) {
  578.             write_line('}');
  579.             undef $chain;
  580.         }
  581.     } else {
  582.         print STDERR "line $. was not understood, ignoring it\n";
  583.     }
  584. }
  585.  
  586. if (keys %policies > 0) {
  587.     while (my ($chain, $policy) = each %policies) {
  588.         write_line('chain', $chain, 'policy', $policy, ';');
  589.     }
  590. }
  591.  
  592. flush_domain if defined $domain;
  593.  
  594. die unless $indent == 0;
  595.  
  596. __END__
  597.  
  598. =head1 NAME
  599.  
  600. import-ferm - import existing firewall rules into ferm
  601.  
  602. =head1 SYNOPSIS
  603.  
  604. B<import-ferm> > ferm.conf
  605.  
  606. iptables-save | B<import-ferm> > ferm.conf
  607.  
  608. B<import-ferm> I<inputfile> > ferm.conf
  609.  
  610. =head1 DESCRIPTION
  611.  
  612. This script helps you with porting an existing IPv4 firewall
  613. configuration to ferm.  It reads a file generated with
  614. B<iptables-save>, and tries to suggest a ferm configuration file.
  615.  
  616. If no input file was specified on the command line, B<import-ferm>
  617. runs F<iptables-save>.
  618.  
  619. =head1 BUGS
  620.  
  621. iptables-save older than 1.3 is unable to write valid saves - this is
  622. not a bug in B<import-ferm>.
  623.  
  624. =cut
  625.